home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 46 / 046.d81 / one for one (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  7KB  |  254 lines
  1. 10 poke53280,0:poke53281,0:printchr$(142)"[147]":clr
  2. 15 cl$="                                      "
  3. 20 s=54272:forl=0to24:pokes+l,3:nextl
  4. 30 dimpc(30),pc$(30),cc(30),cc$(30),pt(30),ct(30)
  5. 40 ta=14:co=1:gosub930
  6. 50 print"[145][145][145][145][145][145][145]"tab(ta+2)"o n e"
  7. 60 print""tab(ta+3)"for"
  8. 70 print""tab(ta+3)"one[146]"
  9. 80 fora=1to40:print"[158][192]";:nexta:print
  10. 90 print"[145]created and designed by:jeff babuschak"
  11. 100 fora=1to40:print"[158][192]";:nexta:print
  12. 110 printtab(6)"press the spacebar[146] to begin":open1,0
  13. 115 print"            press q to quit"
  14. 120 geta$:ifa$=""then120
  15. 130 ifa$=" "then150
  16. 135 ifa$="q"then60000
  17. 140 goto120
  18. 150 print"[147][158]"tab(8)"stack"tab(21)"card in play"
  19. 160 cn=1:nc=1:ta=6:co=1:gosub930
  20. 170 print"[145][145][145][145][145][145][145]"tab(ta+2)" one"
  21. 180 print""tab(ta+3)"for"
  22. 190 print""tab(ta+3)"one[146]"
  23. 200 print:print
  24. 210 fora=1to39:print"[192]";:nexta:print
  25. 220 rem *** main routine ***
  26. 230 print"":ta=23:c=1:gosub370:ifpc(1)>9then230
  27. 240 co=pt(1):cc=co:gosub930:nc=1:cp=pc(1)
  28. 250 print"one moment - shuffling cards[145]"
  29. 260 forzz=1to7:nc=zz:cn=zz:gosub370:nc=zz:cn=zz:gosub630:gosub2310:nextzz
  30. 270 gosub2100
  31. 280 printtab(13)"[145]dealing cards[146]"
  32. 290 ifcn=1thenprinttab(9)"[145]the computer has one card [146]":gosub3000
  33. 300 cr=0:ifcn=0ornc=0then2210
  34. 310 gosub1060:gosub2160
  35. 320 gosub2100
  36. 330 fora=1tonc:ifpt(a)=ccorpc(a)=13orpc(a)=14orpc(a)=cpthen1300
  37. 340 nexta
  38. 350 printtab(12)"[145]you must draw a card[146]":fort=1to1000:nextt:gosub2100
  39. 360 nc=nc+1:gosub370:gosub2160:goto1630
  40. 370 rem *** player get card ***
  41. 380 du=0:pc(nc)=int(0+rnd(1)*15):pt(nc)=int(10+rnd(1)*4):gosub1060
  42. 390 ifpc(nc)=0then430
  43. 400 ifpc(nc)=13orpc(nc)=14thenpt(nc)=12:goto570
  44. 410 goto490
  45. 420 rem *** check # of zero cards ***
  46. 430 fora=1tonc:ifpc(a)=pc(nc)andpt(a)=pt(nc)thendu=du+1
  47. 440 ifpc(a)=cc(nc)andpt(a)=ct(nc)thendu=du+1
  48. 450 ifpc(a)=ccthendu=du+1
  49. 460 nexta
  50. 470 ifdu>1then380
  51. 480 goto890
  52. 490 rem *** check # of reg. cards ***
  53. 500 fora=1tonc:ifpc(a)=pc(nc)andpt(a)=pt(nc)thendu=du+1
  54. 510 ifpc(a)=cc(nc)andpt(a)=ct(nc)thendu=du+1
  55. 520 ifpc(a)=ccthendu=du+1
  56. 530 nexta
  57. 540 ifdu>2then380
  58. 550 goto890
  59. 560 rem *** check # of wild cards ***
  60. 570 fora=1tonc:ifpc(a)=pc(nc)andpt(a)=pt(nc)thendu=du+1
  61. 580 ifpc(a)=cc(nc)andpt(a)=ct(nc)thendu=du+1
  62. 590 ifpc(a)=ccthendu=du+1
  63. 600 nexta
  64. 610 ifdu>4then380
  65. 620 goto890
  66. 630 rem *** computer get card ***
  67. 640 du=0:cc(cn)=int(0+rnd(1)*15):ct(cn)=int(10+rnd(1)*4):gosub1190
  68. 650 ifcc(cn)=0then690
  69. 660 ifcc(cn)=13orcc(cn)=14thenct(cn)=12:goto830
  70. 670 goto750
  71. 680 rem *** check # of zero cards ***
  72. 690 fora=1tocn:ifcc(a)=pc(cn)andct(a)=pt(cn)thendu=du+1
  73. 700 ifcc(a)=cc(cn)andct(a)=ct(cn)thendu=du+1
  74. 710 ifcc(a)=ccthendu=du+1
  75. 720 nexta
  76. 730 ifdu>1then640
  77. 740 goto910
  78. 750 rem *** check # of reg. cards ***
  79. 760 fora=1tocn:ifcc(a)=cc(cn)andct(a)=ct(cn)thendu=du+1
  80. 770 ifcc(a)=pc(cn)andct(a)=pt(cn)thendu=du+1
  81. 780 ifcc(a)=ccthendu=du+1
  82. 790 nexta
  83. 800 ifdu>2then640
  84. 810 goto910
  85. 820 rem *** check # of wild cards ***
  86. 830 fora=1tocn:ifcc(a)=cc(cn)andct(a)=ct(cn)thendu=du+1
  87. 840 ifcc(a)=pc(cn)andct(a)=pt(cn)thendu=du+1
  88. 850 ifcc(a)=ccthendu=du+1
  89. 860 nexta
  90. 870 ifdu>4then640
  91. 880 goto910
  92. 890 rem *** assign player ***
  93. 900 du=0:gosub1060:return
  94. 910 rem *** assign computer ***
  95. 920 du=0:gosub1190:return
  96. 930 rem *** draw card ***
  97. 940 poke646,co:pc$(0)="[169] "
  98. 950 printtab(ta)"[213][192][192][192][192][192][192][192][201]"
  99. 960 ifcr<>1thenprinttab(ta)"[221]";mid$(pc$(c),1,3)"   [223][146] [221]"
  100. 970 ifcr=1thenprinttab(ta)"[221]";mid$(cc$(c),1,3)"   [223][146] [221]"
  101. 980 printtab(ta)"[221]      [223][146][221]"
  102. 990 printtab(ta)"[221]       [146][221]"
  103. 1000 printtab(ta)"[221]       [146][221]"
  104. 1010 printtab(ta)"[221]       [146][221]"
  105. 1020 printtab(ta)"[221][223]      [146][221]"
  106. 1030 printtab(ta)"[221] [223]    [146][169][221]"
  107. 1040 printtab(ta)"[202][192][192][192][192][192][192][192][203]"
  108. 1050 return
  109. 1060 rem *** assign values ***
  110. 1070 fora=1tonc
  111. 1080 ifpc(a)=>0andpc(a)<=9thenpc$(a)=right$(str$(pc(a)),1)+" "
  112. 1090 ifpt(a)=10thenpt(a)=6
  113. 1100 ifpt(a)=11thenpt(a)=5
  114. 1110 ifpt(a)=12thenpt(a)=2
  115. 1120 ifpt(a)=13thenpt(a)=7
  116. 1130 ifpc(a)=10thenpc$(a)="d2"
  117. 1140 ifpc(a)=11thenpc$(a)="re"
  118. 1150 ifpc(a)=12thenpc$(a)="sk"
  119. 1160 ifpc(a)=13thenpc$(a)="wi":pt(a)=12
  120. 1170 ifpc(a)=14thenpc$(a)="w4":pt(a)=12
  121. 1180 nexta:return
  122. 1190 fora=1tocn:ifcc(a)=>0andcc(a)<=9thencc$(a)=right$(str$(cc(a)),1)+" "
  123. 1200 ifct(a)=10thenct(a)=6
  124. 1210 ifct(a)=11thenct(a)=5
  125. 1220 ifct(a)=12thenct(a)=2
  126. 1230 ifct(a)=13thenct(a)=7
  127. 1240 ifcc(a)=10thencc$(a)="d2"
  128. 1250 ifcc(a)=11thencc$(a)="re"
  129. 1260 ifcc(a)=12thencc$(a)="sk"
  130. 1270 ifcc(a)=13thencc$(a)="wi":ct(a)=12
  131. 1280 ifcc(a)=14thencc$(a)="w4":ct(a)=12
  132. 1290 nexta:return
  133. 1300 rem *** player's routine ***
  134. 1310 print"[145]"tab(7)"put cursor on card to play[146]":lo=1545:c=1
  135. 1320 uc=peek(lo):pokelo,160:fort=1to100:nextt
  136. 1330 pokelo,uc:fort=1to100:nextt
  137. 1340 getk$:ifk$=""then1320
  138. 1350 ifk$="[145]"andlo>1585thenpokelo,uc:lo=lo-80:c=c-11:goto1320
  139. 1360 ifk$=""andpeek(lo+80)<>160thenpokelo,uc:lo=lo+80:c=c+11:goto1320
  140. 1370 ifk$="[157]"andpeek(lo-3)<>32thenpokelo,uc:lo=lo-3:c=c-1:goto1320
  141. 1380 ifk$=""andpeek(lo+3)<>160thenpokelo,uc:lo=lo+3:c=c+1:goto1320
  142. 1390 ifk$=chr$(13)then1410
  143. 1400 goto1320
  144. 1410 ifpt(c)=ccorpc(c)=cporpc(c)=13orpc(c)=14thenta=23:cc=pt(c):cp=pc(c)
  145. 1420 ifpt(c)=ccorpc(c)=cporpc(c)=13orpc(c)=14thenprint"":goto1450
  146. 1430 print"[145]"tab(6)"that card can not be laid down[146]":fort=1to500:nextt
  147. 1440 gosub2100:goto1310
  148. 1450 co=cc:gosub930
  149. 1460 ifpc(c)=13orpc(c)=14thengosub2100:gosub3100
  150. 1470 ifpc(c)<>13andpc(c)<>14then1530
  151. 1480 input#1,c$:ok=.
  152. 1485 ifleft$(c$,1)="b"thencc=6:co=cc:cp=pc(c):ta=23:print"":gosub930:ok=-1
  153. 1490 ifleft$(c$,1)="g"thencc=5:co=cc:ta=23:cp=pc(c):print"":gosub930:ok=-1
  154. 1500 ifleft$(c$,1)="r"thencc=2:co=cc:ta=23:cp=pc(c):print"":gosub930:ok=-1
  155. 1510 ifleft$(c$,1)="y"thencc=7:cp=pc(c):ta=23:print"":co=cc:gosub930:ok=-1
  156. 1520 ifnot(ok)thengosub3200
  157. 1530 ifpc(c)=14thengosub3300
  158. 1540 ifpc(c)=14thenforx=1to4:cn=cn+1:gosub630:nextx
  159. 1550 ifpc(c)=10thengosub3400
  160. 1560 ifpc(c)=10thencn=cn+1:gosub630:cn=cn+1:gosub630
  161. 1570 ifpc(c)=10orpc(c)=11orpc(c)=12orpc(c)=14thenpl=1
  162. 1580 fora=ctonc:pc(a)=pc(a+1):pt(a)=pt(a+1):nexta:nc=nc-1:gosub1060
  163. 1590 ifnc=0orcn=0then2210
  164. 1600 gosub2130:gosub2100
  165. 1610 ifpl=1thenpl=0:c=1:goto290
  166. 1620 gosub2160
  167. 1630 rem *** computer's routine ***
  168. 1640 ifcp=>0andcp<10andcr=1then290
  169. 1650 ifcp=13andcr=1then290
  170. 1660 gosub1190:gosub2100
  171. 1665 d2=0:wi=0:w4=0:t2=0:cl=0:sc=0:b=0:g=0:r=0:y=0:cr=1:gc=0
  172. 1670 printtab(8)"[145]it is the computer's turn[146]"
  173. 1675 fort=1to1000:nextt:gosub2100
  174. 1680 ifcn=1thenprinttab(9)"[145]the computer has one card [146]":gosub3500
  175. 1690 fora=1tocn:ifcc(a)=10andct(a)=ccorcc(a)=cpthend2=a
  176. 1700 ifcc(a)=13thenwi=a
  177. 1710 ifcc(a)=14thenw4=a
  178. 1720 ifcc(a)=11andct(a)=ccthent2=a
  179. 1730 ifcc(a)=12andct(a)=ccthent2=a
  180. 1740 ifcc(a)=11andcc(a)=cpthent2=a
  181. 1750 ifcc(a)=12andcc(a)=cpthent2=a
  182. 1760 ifcc(a)=cporct(a)=ccthencl=a
  183. 1770 ifct(a)=ccthensc=a
  184. 1780 ifct(a)=6thenb=b+1
  185. 1790 ifct(a)=5theng=g+1
  186. 1800 ifct(a)=2thenr=r+1
  187. 1810 ifct(a)=7theny=y+1
  188. 1820 nexta
  189. 1830 ifb=>gandb=>randb=>ythengc=6
  190. 1840 ifg=>bandg=>randg=>ythengc=5
  191. 1850 ifr=>bandr=>gandr=>ythengc=2
  192. 1860 ify=>bandy=>gandy=>rthengc=7
  193. 1870 ift2<>0thena=t2:gosub1960:goto1630
  194. 1880 ifw4<>0andsc=0andnc<3thena=w4:ct(a)=gc:gosub1960:goto1630
  195. 1890 ifd2<>0thena=d2:gosub1960:goto1630
  196. 1900 ifcl<>0andnc<>1thena=cl:gosub1960:goto290
  197. 1910 ifwi<>0thena=wi:ct(a)=gc:gosub1960:goto290
  198. 1920 ifw4<>0andsc=0thena=w4:ct(a)=gc:gosub1960:goto1630
  199. 1930 ifcl<>0thena=cl:gosub1960:goto290
  200. 1940 printtab(6)"[145]the computer must draw a card":fort=1to500:nextt
  201. 1950 cn=cn+1:gosub630:gosub2100:gosub1190:goto290
  202. 1960 rem *** com. lay down card **
  203. 1970 ifct(a)=12thenct(a)=gc
  204. 1980 co=ct(a):cp=cc(a):cc=co:cn=cn-1:c=a:ta=23:print"":cr=1:gosub930
  205. 1990 ifcc(a)=14thenprinttab(8)"you must draw four cards[146]":gosub3600
  206. 2000 ifcc(a)=10thenprinttab(8)"you must draw two cards[146]":gosub3600
  207. 2010 ff=a
  208. 2020 ifcc(a)=14thenforx=1to4:nc=nc+1:gosub370:nextx:gosub1060:gosub2160
  209. 2030 a=ff
  210. 2040 ifcc(a)=10thenforx=1to2:nc=nc+1:gosub370:nextx:gosub1060:gosub2160
  211. 2050 a=ff
  212. 2060 forz=atocn:cc(z)=cc(z+1):ct(z)=ct(z+1):nextz:gosub1190
  213. 2070 gosub2100:a=ff
  214.